Atari Mega Archive 2/Atari Mega Archive CD - Volume 2.iso/8bit/cislib_b/pspic.xmo

Text File | 1995-04-22 | 8KB | 1 lines

;Print Shop Screen Magic¢;and Graphic Library ¢;File conversion utility¢;by Mike Collins¢;ver. 2¢;8/20/85¢;בנלסחכדáחמáבIJצדáצדמצחקחשדáלנגד«¢BYTE ramtop=106, hitop, lotop,¢clear=[0], intact=[1], picflag=[0],¢over¢BYTE ARRAY fname, filename¢CARD smem=88, screen, dlhi, xpos, ypos¢TYPE directory=[BYTE n0,n1,n2,n3,n4,¢n5,n6,n7,n8,n9,na,nb,nc,nd,ne,nf¢CARD startsec, PA, bytes]¢directory POINTER file¢;************************************¢;Burst (Block) I/O routines to do¢;quick disk I/O, utilizing a call to¢;CIO¢;************************************¢¢PROC CIO=$E456(BYTE areg,xreg)¢¢;************************************¢¢CARD FUNC Burst(BYTE chan,mode,¢                CARD addr,buflen)¢¢  TYPE IOCB=[BYTE id,num,cmd,stat¢             CARD badr,padr,blen¢             BYTE a1,a2,a3,a4,a5,a6]¢¢  IOCB POINTER iptr¢¢  chan==&$07¢  iptr=$340+(chan LSH 4)¢  iptr.cmd=mode¢  iptr.blen=buflen¢  iptr.badr=addr¢  CIO(0,chan LSH 4)¢RETURN(iptr.stat)¢¢;************************************¢¢BYTE FUNC BPut(BYTE chan¢               CARD addr,len)¢BYTE stat¢    stat=Burst(chan,11,addr,len)¢RETURN(stat)¢¢;************************************¢PROC DISKINV=$E453()¢;************************************¢BYTE FUNC resdisk(BYTE drv, cmd¢                  CARD buf, sec)¢¢TYPE DCB=[BYTE sbi, dnum, com, stat¢          CARD addr, to, cnt, secnum]¢¢DCB POINTER disk¢disk=$300¢disk.dnum=drv¢disk.com=cmd¢disk.addr=buf¢disk.secnum=sec¢DISKINV()          ¢RETURN(disk.stat)               ¢;************************************¢BYTE FUNC GetSec(BYTE drv¢                 CARD buf, sec)¢BYTE stat¢stat=resdisk(drv, 'R, buf, sec)¢RETURN(stat)¢;************************************¢PROC shift(CARD buffer)¢PokeC($CB,buffer)¢[24  160 0  8   40  177 203 106 ¢ 145 203 8  200 192 12  208 244 ¢ 40]¢RETURN¢;************************************¢PROC overlay(CARD to, from, length)¢BYTE POINTER pointto, pointfrom¢CARD count¢FOR count=0 TO length-1¢DO¢pointto=count+to pointfrom=count+from¢pointto^=pointto^ OR pointfrom^¢OD¢RETURN¢;************************************¢PROC vdelay()¢BYTE jiffy, clock=20¢jiffy=clock      ;This loop ensures¢DO               ;that 1 vbl interupt¢UNTIL jiffy#clock;will occur. All ¢OD               ;hardware registers¢RETURN           ;will be updated.¢;************************************¢BYTE FUNC uppercase(BYTE chr)¢IF chr>='a AND chr<='z THEN¢   RETURN(chr-$20)¢FI¢RETURN(chr)¢;************************************¢PROC nobreak() ;disable break key¢Poke(16,64) Poke(53774,64)¢RETURN¢;************************************¢PROC ercheck(BYTE ernum)¢IF ernum#1  ;error check routine¢THEN        ;if ernum<>1 then report¢ramtop=lotop ;error to user¢Graphics(0) nobreak()¢vdelay()¢Position(8,11) Print("ERROR #")¢PrintBE(ernum)¢Position(8,13) Print("Press any key")¢ernum=1¢GetD(7)¢FI¢RETURN¢;************************************¢PROC init()¢hitop=ramtop¢Graphics(24) nobreak()¢screen=smem¢lotop=Peek(561)-1 dlhi=PeekC(560)¢Error=ercheck¢filename="D1:            "¢RETURN¢;************************************¢BYTE FUNC menu()¢BYTE selection¢ramtop=lotop ;put menu under screen¢Graphics(0) nobreak()¢Position(9,8) PrintE("כoad Print Shop File")¢Position(9,10) PrintE("צave File(Atari DOS)") ¢DO¢Position(9,12) Print("Make Selection:")¢selection=GetD(7) selection==&127¢selection=uppercase(selection)¢Put(selection)¢UNTIL selection='L OR selection='S¢OD¢RETURN(selection)¢;************************************¢PROC showscreen(BYTE option)¢BYTE mode, jiffy, clock=20¢;clear screen if option=0¢ramtop=hitop ;set ramtop for gr.8¢IF option=clear THEN¢ Graphics(24)¢ nobreak()¢ picflag=0 ;erase picture¢ELSE¢PokeC(560,dlhi)¢FI¢vdelay()¢RETURN¢;************************************¢CARD FUNC psdir()¢BYTE x, stat      ¢BYTE ARRAY dirbuf(129)¢CARD sector¢ramtop=lotop¢Graphics(0) nobreak()¢ ¢PrintE("צסIJבד for next file, פדקרפמ to load")¢ PutE()¢ Poke(85,6) PrintE("Filename        File Type")¢ PutE()¢ FOR sector=362 TO 392¢ DO                     ;read¢ stat=GetSec(1,dirbuf+1,sector);directory¢    IF stat#1 THEN¢    ercheck(stat)¢    EXIT¢    FI¢   fname=dirbuf¢   FOR x=1 TO 4¢   DO¢   IF fname(1)=0 THEN RETURN(0) FI¢   fname(0)=15 file=fname+1¢   Poke(85,6)¢   Print(fname) ;print filenames¢   Print(" ")¢    IF file.bytes<641¢    THEN PrintE("Graphic")¢    ELSE PrintE("Screen Magic")¢    FI¢     IF GetD(7)=155 THEN¢     Poke(filename(1),'D)¢     Poke(filename(3),':)¢     filename(0)=15¢     MoveBlock(filename+4,fname+1,8)¢     RETURN(file.startsec)¢     FI¢   fname==+32¢   OD¢ OD¢RETURN(0)¢¢;************************************¢BYTE FUNC getcoord()¢BYTE option¢ramtop=lotop¢Graphics(0) nobreak()¢xpos=0 ypos=0¢Position(8,5) Print("This is a graphic file.")¢DO¢Position(6,7) Print("Enter X coordinate(0-232):      ~~~~~~")¢xpos=InputC()¢UNTIL xpos<233¢OD¢DO¢Position(6,9) Print("Enter Y coordinate(0-140):      ~~~~~~")¢ypos=InputC()¢UNTIL ypos<141¢OD¢ IF picflag=1¢ THEN¢ DO¢ Position(6,11) Print("בlear or דxisting Screen?:    ~~~~")¢ option=GetD(7) option==&127¢ option=uppercase(option)¢ UNTIL option='C OR option='E¢ OD Put(option)¢  IF option='E¢  THEN¢  DO¢  Position(6,13) Print("Overlay(Y/N)?:")¢  over=GetD(7) over==&127¢  over=uppercase(over)¢  UNTIL over='Y OR over='N¢  OD Put(over)¢  FI¢  ELSE option='C over='N¢  FI¢   IF option='C¢   THEN option=clear¢   ELSE option=intact¢   FI¢RETURN(option)¢;************************************¢BYTE FUNC psload(CARD sector) ;return error #¢BYTE stat¢CARD offset, seccnt¢offset=0¢showscreen(clear)¢FOR seccnt=1 TO 61¢DO¢stat=GetSec(1,screen+offset,sector)¢  IF stat#1 THEN EXIT FI¢offset==+126¢sector=PeekC(screen+offset);sector link¢IF sector=0 OR sector>720¢THEN EXIT FI¢OD¢ercheck(stat)¢picflag=1¢RETURN(stat)¢;************************************¢BYTE FUNC gfxload(CARD sector, option) ;return error #¢BYTE stat, wait, bak=710, point=709,¢     i, bits¢BYTE ARRAY gfxbuf(640), shiftbuf(12)¢CARD offset, seccnt¢offset=0¢showscreen(option) bak=8 point=0¢vdelay()¢FOR seccnt=1 TO 5¢DO¢ stat=GetSec(1,gfxbuf+offset,sector)¢  IF stat#1 THEN EXIT FI¢ offset==+126¢ sector=PeekC(gfxbuf+offset);sector link¢   IF sector=0 OR sector>720¢   THEN EXIT FI¢OD¢ercheck(stat)¢picflag=1¢bits=xpos&7 xpos== RSH 3 ¢ FOR offset=0 TO 51¢ DO¢  IF bits#0 THEN shiftbuf(11)=0¢   MoveBlock(shiftbuf,gfxbuf+offset*11,11)¢   FOR i=1 TO bits¢   DO  ¢   shift(shiftbuf)¢   OD ¢    IF over='Y THEN¢    overlay(screen+offset*40+xpos+40*ypos,shiftbuf,12)¢    ELSE¢    MoveBlock(screen+offset*40+xpos+40*ypos,shiftbuf,12)¢    FI¢  ELSE¢    IF over='Y THEN¢    overlay(screen+offset*40+xpos+40*ypos,gfxbuf+offset*11,11)¢    ELSE¢    MoveBlock(screen+offset*40+xpos+40*ypos,gfxbuf+offset*11,11)¢    FI¢  FI¢ OD¢GetD(7) ;wait for keypress¢RETURN(stat)¢;************************************¢PROC saveit()¢BYTE stat¢ramtop=lotop¢Graphics(0) nobreak()¢IF picflag THEN ¢ Position(15,8) Print("Save Screen")¢ Position(8,10) Print("Insert disk with Atari DOS")¢ Position(8,12) Print("Enter filename or פדקרפמ.")¢ Position(8,14) Print(filename)¢ Position(8,14) Print("") InputS(filename)¢ showscreen(intact)¢ Close(2) ;just in case¢ Open(2,filename,8,0)¢ stat=BPut(2,screen,7680)¢  IF stat#136 THEN ercheck(stat) FI¢ Close(2)¢   ELSE¢   Put(253)¢   Position(8,10) Print("No Picture in Memory!")¢   Position(11,12) Print("Press any key")¢   GetD(7)¢FI¢RETURN¢;************************************¢PROC main()¢BYTE choice, stat¢CARD start, option¢init()¢DO¢ choice=menu()¢  IF choice='L¢  THEN start=psdir() ;get first sector¢    IF start#0¢    THEN¢     IF file.bytes<641¢     THEN option=getcoord()¢          gfxload(start,option);load graphic ¢     ELSE psload(start);load picture¢     FI¢    FI¢  ELSEIF choice='S¢  THEN saveit()¢  FI ¢OD¢RETURN¢¢yyyyyyy